home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / NAVIGATE.PRG < prev    next >
Text File  |  1992-12-23  |  29KB  |  751 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: NAVIGATE.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: These are interesting functions designed to help out in 
  6. *--             navigation ... see the file: README.TXT for details on the
  7. *--             use of this library file. 
  8. *--             NOTE -- a few functions have been added into this library
  9. *--             that are duplicated elsewhere (other library files). This is
  10. *--             due to a limitation with dBASE IV, 1.5's handling of libraries.
  11. *--             These functions are (and are from):
  12. *--             STRIP2VAL()   from STRINGS.PRG
  13. *--             STRIPVAL()
  14. *--             STRPBRK()
  15. *--             HAV()         from TRIG.PRG
  16. *--             AHAV()
  17. *--             CSCH()
  18. *--             SINH()
  19. *-------------------------------------------------------------------------------
  20.  
  21. FUNCTION Correct
  22. *-------------------------------------------------------------------------------
  23. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  24. *-- Date........: 03/01/1992
  25. *-- Notes.......: Correction of direction - adjusts direction given, in degrees,
  26. *--               by second number of degrees.  Use to convert a compass
  27. *--               direction to magnetic using deviation as the second argument,
  28. *--               or magnetic to true using variation as the second argument.
  29. *--               Returns a direction in degrees.
  30. *--
  31. *--               A westerly second argument may be given either as a negative
  32. *--               number or as a character value containing "W".  If second
  33. *--               argument is character-type but contains a negative value,
  34. *--               effect of presence or absence of "W" is reversed.  That is,
  35. *--               "-20 W" is treated like "20 E" or the number 20.
  36. *-- Written for.: dBASE IV, 1.1
  37. *-- Rev. History: None
  38. *-- Calls.......: None
  39. *-- Called by...: Any
  40. *-- Usage.......: Correct(<nDirection>,<xCorrection>)
  41. *-- Example.....: ?Correct(50,"-10 E")
  42. *-- Returns.....: Numeric (direction in degrees)
  43. *-- Parameters..: nDirection  = Heading
  44. *--               xCorrection = amount to 'correct' by, may be numeric or
  45. *--                             character, see above under 'Notes'.
  46. *-------------------------------------------------------------------------------
  47.  
  48.     parameters nDirection, xCorrection
  49.     private nCval
  50.     if type( "xCorrection" ) = "C"
  51.       nCval = val( xCorrection )
  52.       if "W" $ upper( xCorrection )
  53.         nCval = - nCval
  54.       endif
  55.     else
  56.       nCval = xCorrection
  57.     endif
  58.     
  59. RETURN mod( 360 + nDirection + nCval, 360 )
  60. *-- EoF: Correct()
  61.  
  62. FUNCTION UnCorrect
  63. *-------------------------------------------------------------------------------
  64. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  65. *-- Date........: 03/01/1992
  66. *-- Notes.......: Uncorrection of direction - adjusts direction given, in 
  67. *--               degrees, by second number of degrees.  The inverse of 
  68. *--               correct(), see above. Use to convert a true direction to 
  69. *--               magnetic using variation as the second argument, or magnetic
  70. *--               to compass using deviation as the second argument.
  71. *-- Written for.: dBASE IV, 1.1
  72. *-- Rev. History: None
  73. *-- Calls.......: None
  74. *-- Called by...: Any
  75. *-- Usage.......: UnCorrect(<nDirection>,<xUnCorr>)
  76. *-- Example.....: ?UnCorrect(50,"-10 E")
  77. *-- Returns.....: Numeric (direction in degrees)
  78. *-- Parameters..: nDirection = Heading
  79. *--               xUnCorr    = amount to 'uncorrect' by, may be numeric or
  80. *--                             character, see above under 'Notes'.
  81. *-------------------------------------------------------------------------------
  82.  
  83.     parameters nDirection, xUncorr
  84.     private nCval
  85.     if type( "xUncorr" ) = "C"
  86.       nCval = val( xUncorr )
  87.       if "W" $ upper( xUncorr )
  88.         nCval = - nCval
  89.       endif
  90.     else
  91.       nCval = xUncorr
  92.     endif
  93.     
  94. RETURN mod( 360 + nDirection - nCval, 360 )
  95. *-- EoF: UnCorrect()
  96.  
  97. FUNCTION XAngle
  98. *-------------------------------------------------------------------------------
  99. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  100. *-- Date........: 03/01/1992
  101. *-- Notes.......: Angle in degrees ( <= 90 ) at which two vectors in
  102. *--               degrees intersect.
  103. *-- Written for.: dBASE IV, 1.1
  104. *-- Rev. History: None
  105. *-- Calls.......: None
  106. *-- Called by...: Any
  107. *-- Usage.......: XAngle(<nVector1>,<nVector2>)
  108. *-- Example.....: ?UnCorrect(20,240)
  109. *-- Returns.....: Numeric (direction in degrees)
  110. *-- Parameters..: nVector1 = First angle
  111. *--               nVector2 = Second angle
  112. *-------------------------------------------------------------------------------
  113.  
  114.     parameters nVector1, nVector2
  115.     private nResult
  116.     nResult = abs( nVector1 - nVector2)
  117.     do case
  118.       case nResult > 270
  119.             nResult = 360 - Result
  120.       case nResult > 180
  121.         nResult = nResult - 180
  122.       case nResult > 90
  123.         nResult = 180 - nResult
  124.     endcase
  125.     
  126. RETURN nResult
  127. *-- EoF: XAngle()
  128.  
  129. FUNCTION LeftWind
  130. *-------------------------------------------------------------------------------
  131. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  132. *-- Date........: 03/01/1992
  133. *-- Notes.......: Whether effect of second vector on first is from the
  134. *--               left or the right.  Returns .T. if from the left, else .F.
  135. *--               Expects vectors in degrees.
  136. *--
  137. *--               For convenience in aviation calculations, the second
  138. *--               argument is expected as the direction FROM which
  139. *--               the wind or current is coming, not the direction TO
  140. *--               which it is going.  If the contrary sense
  141. *--               is more convenient, change the "=" sign in the
  142. *--               function to "#".
  143. *-- Written for.: dBASE IV, 1.1
  144. *-- Rev. History: None
  145. *-- Calls.......: None
  146. *-- Called by...: Any
  147. *-- Usage.......: LeftWind(<nCourse>,<nWindFrom>)
  148. *-- Example.....: ?LeftWind(20,240)
  149. *-- Returns.....: Numeric (direction in degrees)
  150. *-- Parameters..: nCourse   = Direction of heading ...
  151. *--               nWindFrom = Direction wind or current is coming from
  152. *-------------------------------------------------------------------------------
  153.  
  154.     parameters nCourse, nWindfrom
  155.     
  156. RETURN ( nCourse > nWindfrom ) = ( abs( nCourse - nWindfrom ) < 180 )
  157. *-- EoF: LeftWind()
  158.  
  159. FUNCTION TailWind
  160. *-------------------------------------------------------------------------------
  161. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  162. *-- Date........: 03/01/1992
  163. *-- Notes.......: Whether effect of second vector on first is additive
  164. *--               or subtractive ( from behind or from ahead ).
  165. *-- 
  166. *--               For convenience in aviation calculations, the second
  167. *--               argument is expected as the direction FROM which
  168. *--               the wind or current is coming, not the direction TO
  169. *--               which is going.  If the contrary sense
  170. *--               is more convenient, change the "<" sign in the
  171. *--               function to ">".
  172. *-- Written for.: dBASE IV, 1.1
  173. *-- Rev. History: None
  174. *-- Calls.......: None
  175. *-- Called by...: Any
  176. *-- Usage.......: TailWind(<nCourse>,<nWindFrom>)
  177. *-- Example.....: ?TailWind(20,240)
  178. *-- Returns.....: Numeric (direction in degrees)
  179. *-- Parameters..: nCourse   = Direction of heading ...
  180. *--               nWindFrom = Direction wind or current is coming from
  181. *-------------------------------------------------------------------------------
  182.  
  183.     parameters nCourse, nWindfrom
  184.     
  185. RETURN ( abs( abs( nCourse - nWindfrom ) - 180 ) < 90 )
  186. *-- EoF: TailWind()
  187.  
  188. FUNCTION Heading
  189. *-------------------------------------------------------------------------------
  190. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  191. *-- Date........: 03/01/1992
  192. *-- Notes.......: Heading required to make good a course.
  193. *--               If using this for boating and the direction of set is
  194. *--               more convenient than the direction from which
  195. *--               it is coming, apply mod( 180 + direction, 360 )
  196. *--               to the fourth argument before calling.
  197. *-- Written for.: dBASE IV, 1.1
  198. *-- Rev. History: None
  199. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  200. *--               LEFTWIND()           Function in NAVIGATE.PRG
  201. *-- Called by...: Any
  202. *-- Usage.......: Heading(<nCourse>,<nAirSpeed>,<nWindFrom>,<nForce>)
  203. *-- Example.....: ?Heading(20,5,240,2)
  204. *-- Returns.....: Numeric (direction in degrees)
  205. *-- Parameters..: nCourse   = Direction of heading ...
  206. *--               nAirSpeed = What it says
  207. *--               nWindFrom = Direction wind or current is coming from
  208. *--               nForce    = Windforce
  209. *-------------------------------------------------------------------------------
  210.  
  211.     parameters nCourse, nAirspeed, nWindfrom, nForce
  212.     private nCrabAngle
  213.     nCrabAngle = rtod( asin( nForce * sin( dtor( xangle( nCourse, nWindfrom))) ;
  214.           / nAirspeed ) )
  215.     nCrabAngle = iif( leftwind( nCourse, nWindfrom ), -nCrabAngle, nCrabAngle )
  216.     nCrabAngle = mod( 360 + nCourse + nCrabAngle, 360 )
  217.     
  218. RETURN iif( abs( nCrabAngle ) < 360, nCrabAngle, -1 )
  219. *-- EoF: Heading()
  220.  
  221. FUNCTION Course
  222. *-------------------------------------------------------------------------------
  223. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  224. *-- Date........: 03/01/1992
  225. *-- Notes.......: Course made good given heading, speed and wind direction 
  226. *--               and force.
  227. *-- Written for.: dBASE IV, 1.1
  228. *-- Rev. History: None
  229. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  230. *--               LEFTWIND()           Function in NAVIGATE.PRG
  231. *--               TAILWIND()           Function in NAVIGATE.PRG
  232. *-- Called by...: Any
  233. *-- Usage.......: Course(<nHeading>,<nAirSpeed>,<nWindFrom>,<nForce>)
  234. *-- Example.....: ?Course(20,5,240,2)
  235. *-- Returns.....: Numeric (direction in degrees)
  236. *-- Parameters..: nHeading  = Direction of heading ...
  237. *--               nAirSpeed = What it says
  238. *--               nWindFrom = Direction wind or current is coming from
  239. *--               nForce    = Windforce
  240. *-------------------------------------------------------------------------------
  241.  
  242.     parameters nHeading, nAirspeed, nWindfrom, nForce
  243.     private nTemp, nCrabAngle
  244.     nTemp = dtor( xangle( nHeading, nWindfrom ) )
  245.     nCrabAngle = nAirspeed - nForce * cos( nTemp ) ;
  246.        * iif( tailwind( nHeading, nWindfrom ), -1, 1 )
  247.     if nCrabAngle < 0
  248.       nCrabAngle = 0
  249.     else
  250.       nCrabAngle = abs( rtod( atan( nForce * sin( nTemp ) / nCrabAngle ) ) )
  251.       nCrabAngle = iif( leftwind( nHeading,nWindfrom ), nCrabAngle, -nCrabAngle)
  252.     endif
  253.     
  254. RETURN mod( 360 + nHeading + nCrabAngle, 360 )
  255. *-- EoF: Course()
  256.  
  257. FUNCTION GndSpeed
  258. *-------------------------------------------------------------------------------
  259. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  260. *-- Date........: 03/01/1992
  261. *-- Notes.......: Speed over the ground given heading, speed
  262. *--               and wind direction and force.
  263. *-- Written for.: dBASE IV, 1.1
  264. *-- Rev. History: None
  265. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  266. *--               TAILWIND()           Function in NAVIGATE.PRG
  267. *-- Called by...: Any
  268. *-- Usage.......: GndSpeed(<nHeading>,<nAirSpeed>,<nWindFrom>,<nForce>)
  269. *-- Example.....: ?GndSpeed(20,5,240,2)
  270. *-- Returns.....: Numeric (direction in degrees)
  271. *-- Parameters..: nHeading  = Direction of heading ...
  272. *--               nAirSpeed = What it says
  273. *--               nWindFrom = Direction wind or current is coming from
  274. *--               nForce    = Windforce
  275. *-------------------------------------------------------------------------------
  276.  
  277.     parameters nHeading, nAirspeed, nWindfrom, nForce
  278.     private nTemp
  279.     nTemp  = cos( dtor( xangle( nHeading, nWindfrom ) ) ) ;
  280.        * iif( tailwind( nHeading, nWindfrom ), -1, 1 )
  281.     nTemp = nAirspeed * nAirspeed + nForce * nForce ;
  282.        - 2 * nAirspeed * nForce * nTemp
  283.  
  284. RETURN iif(nTemp<=0,nAirspeed+nForce*iif(tailwind(nHeading,nWindfrom ),1,-1),;
  285.                 sqrt(nTemp))
  286. *-- EoF: GndSpeed()
  287.  
  288. FUNCTION Deg2Num
  289. *-------------------------------------------------------------------------------
  290. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  291. *-- Date........: 03/01/1992
  292. *-- Notes.......: Degrees to number: String in the form " 40d50'30.2 N" is 
  293. *--               converted to a number of degrees.  If followed by E or S, 
  294. *-                sign will be reversed.
  295. *--
  296. *--               It doesn't matter what characters are used to separate the
  297. *--               degrees, minutes and seconds, but any of the characters N, E,
  298. *--               W and S or their lowercase equivalents following the last 
  299. *--               digit will be understood as specifying a compass direction.
  300. *-- 
  301. *--               If the degrees or minutes are 0, they must nevertheless be
  302. *--               included in the argument.  Seconds may be omitted if 0, as
  303. *--               may the minutes if 0 and seconds are omitted.
  304. *-- Written for.: dBASE IV, 1.1
  305. *-- Rev. History: None
  306. *-- Calls.......: STRIP2VAL()          Function in STRINGS.PRG
  307. *--               STRIPVAL()           Function in STRINGS.PRG
  308. *--               STRPBRK()            Function in STRINGS.PRG
  309. *-- Called by...: Any
  310. *-- Usage.......: Deg2Num(<cDms>)
  311. *-- Example.....: ?Deg2Num("40d50'30.2 N")
  312. *-- Returns.....: Numeric (degrees)
  313. *-- Parameters..: cDms = Degrees Minutes Seconds
  314. *-------------------------------------------------------------------------------
  315.  
  316.     parameters cDms
  317.     private nResult, cStrleft
  318.     if type( "cDms" ) $ "NF"
  319.       RETURN CDms
  320.     endif
  321.     cStrleft = strip2val( cDms )
  322.     nResult = val( cStrleft )
  323.     if "" # strip2val( stripval( cStrleft ) )
  324.       cStrleft = strip2val( stripval( cStrleft ) )
  325.       nResult = nResult + val( cStrleft ) / 60
  326.       if "" # strip2val( stripval( cStrleft ) )
  327.         cStrleft = strip2val( stripval( cStrleft ) )
  328.         nResult = nResult + val( cStrleft ) / 3600
  329.       endif
  330.     endif
  331.     cStrleft = upper( ltrim( stripval( cStrleft ) ) )
  332.     if strpbrk( "NW", cStrleft ) > 0 .or. strpbrk( "ES",cStrleft ) = 0
  333.       RETURN nResult
  334.     else
  335.       RETURN -nResult
  336.     endif
  337.  
  338. *-- EoF: Deg2Num()
  339.  
  340. FUNCTION BearsDist
  341. *-------------------------------------------------------------------------------
  342. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  343. *-- Date........: 03/01/1992
  344. *-- Notes.......: Distance to an object at the time of the second
  345. *--               bearing, given two bearings and the distance run
  346. *--               between them.  Value returned will be in same
  347. *--               units as third argument; first two are in degrees.
  348. *--               Returns -1 if already past the object.
  349. *-- Written for.: dBASE IV, 1.1
  350. *-- Rev. History: None
  351. *-- Calls.......: None
  352. *-- Called by...: Any
  353. *-- Usage.......: BearsDist(<nBear1>,<nBear2>,<nRun>)
  354. *-- Example.....: ?BearsDist(200,150,5)
  355. *-- Returns.....: Numeric (degrees)
  356. *-- Parameters..: nBear1 = Bearing of First object
  357. *--               nBear2 = Bearing of Second object
  358. *--               nRun   = Distance (or time) run between bearings
  359. *-------------------------------------------------------------------------------
  360.  
  361.     parameters nBear1, nBear2, nRun
  362.     if nBear2 > 180
  363.       if nBear1 < nBear2 .or. nBear2 < 270
  364.         RETURN -1
  365.       else
  366.         nBear1 = 360 - nBear1
  367.         nBear2 = 360 - nBear2
  368.       endif
  369.     else
  370.       if nBear2 < nBear1 .or. nBear2 > 90
  371.         RETURN -1
  372.       endif
  373.     endif
  374.  
  375. RETURN sin( dtor( nBear1 ) ) * nRun / sin( dtor( nBear2 - nBear1 ) )
  376. *-- EoF: BearsDist()
  377.  
  378. FUNCTION BearsPass
  379. *-------------------------------------------------------------------------------
  380. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  381. *-- Date........: 03/01/1992
  382. *-- Notes.......: Distance to an object at the time of the second
  383. *--               bearing, given two bearings and the distance run
  384. *--               between them.  Value returned will be in same
  385. *--               units as third argument; first two are in degrees.
  386. *--               Returns -1 if already past the object.
  387. *-- Written for.: dBASE IV, 1.1
  388. *-- Rev. History: None
  389. *-- Calls.......: None
  390. *-- Called by...: Any
  391. *-- Usage.......: BearsPass(<nBear1>,<nBear2>,<nRun>)
  392. *-- Example.....: ?BearsPass(200,150,5)
  393. *-- Returns.....: Numeric (degrees)
  394. *-- Parameters..: nBear1 = Bearing of First object
  395. *--               nBear2 = Bearing of Second object
  396. *--               nRun   = Distance (or time) run between bearings
  397. *-------------------------------------------------------------------------------
  398.  
  399.     parameters nBear1, nBear2, nRun
  400.     private nTemp
  401.     if nBear2 > 180
  402.       if nBear1 < nBear2 .or. nBear2 < 270
  403.         RETURN -1
  404.       else
  405.         nBear1 = 360 - nBear1
  406.         nBear2 = 360 - nBear2
  407.       endif
  408.     else
  409.       if nBear2 < nBear1 .or. nBear2 > 90
  410.         RETURN -1
  411.       endif
  412.     endif
  413.     nTemp = sin( dtor( nBear1 ) ) * nRun / sin( dtor( nBear2 - nBear1 ) )
  414.     
  415. RETURN nTemp * sin( dtor( nBear2 ) )
  416. *-- EoF: BearsPass()
  417.  
  418. FUNCTION BearsRun
  419. *-------------------------------------------------------------------------------
  420. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  421. *-- Date........: 03/01/1992
  422. *-- Notes.......: Distance to run until object will be abeam given two bearings.
  423. *--               Same rules and restrictions as bearsdist().
  424. *-- Written for.: dBASE IV, 1.1
  425. *-- Rev. History: None
  426. *-- Calls.......: None
  427. *-- Called by...: Any
  428. *-- Usage.......: BearsRun(<nBear1>,<nBear2>,<nRun>)
  429. *-- Example.....: ?BearsRun(200,150,5)
  430. *-- Returns.....: Numeric (degrees)
  431. *-- Parameters..: nBear1 = Bearing of First object
  432. *--               nBear2 = Bearing of Second object
  433. *--               nRun   = Distance (or time) run between bearings
  434. *-------------------------------------------------------------------------------
  435.  
  436.     parameters nBear1, nBear2, nRun
  437.     private nTemp
  438.     if nBear2 > 180
  439.       if nBear1 < nBear2 .or. nBear2 < 270
  440.         RETURN -1
  441.       else
  442.         nBear1 = 360 - nBear1
  443.         nBear2 = 360 - nBear2
  444.       endif
  445.     else
  446.       if nBear2 < nBear1 .or. nBear2 > 90
  447.         RETURN -1
  448.       endif
  449.     endif
  450.     nTemp = sin( dtor( nBear1 ) ) * nRun / sin( dtor( nBear2 - nBear1 ) )
  451.  
  452. RETURN nTemp * cos( dtor( nBear2 ) )
  453. *-- EoF: BearsRun()
  454.  
  455. FUNCTION GcDist
  456. *-------------------------------------------------------------------------------
  457. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  458. *-- Date........: 03/01/1992
  459. *-- Notes.......: Great circle distance between two points given latitude
  460. *--               and longitude of each.  This function obtains the degrees of
  461. *--               arc along the great circle and simply multiplies by 60 to
  462. *--               convert the degrees to nautical miles.  As this ignores the
  463. *--               eccentricity of the earth, the answer may be in error by
  464. *--               approximately half of one percent.  In general, if the
  465. *--               route lies close to the equator the result of this
  466. *--               function will be smaller than the actual number of nautical
  467. *--               miles, but if the route passes close to the poles
  468. *--               the function result will be larger than the correct number.
  469. *-- Written for.: dBASE IV, 1.1
  470. *-- Rev. History: None
  471. *-- Calls.......: DEG2NUM()            Function in NAVIGATE.PRG
  472. *--               HAV()                Function in TRIG.PRG
  473. *--               AHAV()               Function in TRIG.PRG
  474. *-- Called by...: Any
  475. *-- Usage.......: GCDist(<cLat1>,<cLon1>,<cLat2>,<cLon2>)
  476. *-- Example.....: ?GCDist(200,150,105,200)
  477. *-- Returns.....: Numeric (nautical miles)
  478. *-- Parameters..: cLat1 = Latitude 1
  479. *--               cLon1 = Longitude 1
  480. *--               cLat2 = Latitude 2
  481. *--               cLon2 = Longitude 2
  482. *-------------------------------------------------------------------------------
  483.  
  484.     parameters cLat1, cLon1, cLat2, cLon2
  485.     private nLa1, nLo1, nLa2, nLo2, nDla, nDlo, nTemp
  486.     nLa1 = dtor( deg2num( cLat1 ) )
  487.     nLo1 = dtor( deg2num( cLon1 ) )
  488.     nLa2 = dtor( deg2num( cLat2 ) )
  489.     nLo2 = dtor( deg2num( cLon2 ) )
  490.     nDla = abs( nLa1 - nLa2 )
  491.     nDlo = abs( nLo2 - nLo1 )
  492.     do case
  493.       case nDlo = 0 .or. nDla = pi()
  494.         RETURN 60 * rtod( nDla )
  495.       case nDlo = pi()
  496.         RETURN 60 * rtod( ( pi() - nDla ) )
  497.       case nDlo > pi()
  498.         nDlo = 2 * pi() - nDlo
  499.     endcase
  500.     nTemp = hav( nDla ) + hav( nDlo ) * cos( nLa1 ) * cos( nLa2 )
  501.  
  502. RETURN 60 * rtod( ahav( nTemp ) )
  503. *-- EoF: GcDist()
  504.  
  505. FUNCTION GcCourse
  506. *-------------------------------------------------------------------------------
  507. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  508. *-- Date........: 03/01/1992
  509. *-- Notes.......: Initial great circle course between two points given latitude
  510. *--               and longitude of each.  Returns -1 if the points are 
  511. *--               antipodes.
  512. *-- Written for.: dBASE IV, 1.1
  513. *-- Rev. History: None
  514. *-- Calls.......: DEG2NUM()            Function in NAVIGATE.PRG
  515. *--               HAV()                Function in TRIG.PRG
  516. *--               AHAV()               Function in TRIG.PRG
  517. *--               CSCH()               Function in TRIG.PRG
  518. *--               SinH()               Function in TRIG.PRG
  519. *-- Called by...: Any
  520. *-- Usage.......: GCCourse(<cLat1>,<cLon1>,<cLat2>,<cLon2>)
  521. *-- Example.....: ?GCCourse(200,150,105,200)
  522. *-- Returns.....: Numeric (degrees)
  523. *-- Parameters..: cLat1 = Latitude 1
  524. *--               cLon1 = Longitude 1
  525. *--               cLat2 = Latitude 2
  526. *--               cLon2 = Longitude 2
  527. *-------------------------------------------------------------------------------
  528.  
  529.     parameters nLat1, nLon1, nLat2, nLon2
  530.     private nLa1, nLo1, nLa2, nLo2, nDla, nDlo, nTemp, lRev
  531.     nLa1 = dtor( deg2num( nLat1 ) )
  532.     nLo1 = dtor( deg2num( nLon1 ) )
  533.     nLa2 = dtor( deg2num( nLat2 ) )
  534.     nLo2 = dtor( deg2num( nLon2 ) )
  535.     nDla = abs( nLa1 - nLa2 )
  536.     nDlo = abs( nLo2 - nLo1 )
  537.     lRev = .F.
  538.     do case
  539.       case nDla = pi() .or. nDlo = pi () .and. nLa1 + nLa2 = 0
  540.         RETURN -1
  541.       case nDlo = 0 .or. nDlo = pi() .or. abs( nLa1 ) = pi() .or.;
  542.              abs( nLa2 ) = pi()
  543.         RETURN iif( La1 > La2 , 180, 0 )
  544.       case nDlo > pi()
  545.         nDlo = 2 * pi() - nDlo
  546.         lRev = .T.
  547.     endcase
  548.     nTemp = hav( nDla ) + hav( nDlo ) * cos( nLa1 ) * cos( nLa2 )
  549.     nTemp = rtod( asin( sin( nDlo ) * cos( nLa2 ) * csch( ahav( nTemp ) ) ) )
  550.     nTemp = iif( nLa1 > nLa2, 180 - nTemp, nTemp )
  551.     
  552. RETURN iif( ( nLo2 > nLo1 ) = lRev, nTemp, 360 - nTemp )
  553. *-- EoF: GCCourse()
  554.  
  555. *-------------------------------------------------------------------------------
  556. *-- For convenience the following routines were brought in from other library
  557. *-- files.
  558. *-------------------------------------------------------------------------------
  559.  
  560. FUNCTION Strip2Val
  561. *-------------------------------------------------------------------------------
  562. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  563. *-- Date........: 03/01/92
  564. *-- Notes.......: Strip characters from the left of a string until reaching
  565. *--               one that might start a number.
  566. *-- Written for.: dBASE IV
  567. *-- Rev. History: None
  568. *-- Calls.......: None
  569. *-- Called by...: Any
  570. *-- Usage.......: Strip2Val("<cStr>")
  571. *-- Example.....: ? Strip2Val("Test345")
  572. *-- Returns.....: character string
  573. *-- Parameters..: cStr = string to search
  574. *-------------------------------------------------------------------------------
  575.  
  576.     parameters cStr
  577.    private cNew
  578.    cNew = cStr
  579.    do while "" # cNew
  580.       if left( cNew, 1 ) $ "-.0123456789"
  581.          exit
  582.        endif
  583.       cNew = substr( cNew, 2 )
  584.     enddo
  585.     
  586. RETURN cNew
  587. *-- EoF: Strip2Val()
  588.  
  589. FUNCTION StripVal
  590. *-------------------------------------------------------------------------------
  591. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  592. *-- Date........: 03/01/92
  593. *-- Notes.......: Strip characters from the left of the string until
  594. *--               reaching one that is not part of a number.  A hyphen
  595. *--               following numerics, or a second period,
  596. *--               is treated as not part of a number.
  597. *-- Written for.: dBASE IV
  598. *-- Rev. History: None
  599. *-- Calls.......: None
  600. *-- Called by...: Any
  601. *-- Usage.......: StripVal("<cStr>")
  602. *-- Example.....: ? StripVal("123.2Test")
  603. *-- Returns.....: Character
  604. *-- Parameters..: cStr = string to test
  605. *-------------------------------------------------------------------------------
  606.  
  607.     parameters cStr
  608.    private cNew, cChar, lGotminus, lGotdot
  609.    cNew = cStr
  610.    store .f. to lGotminus, lGotdot
  611.    do while "" # cNew
  612.       cChar = left( cNew, 1 )
  613.        do case
  614.           case .not. cChar $ "-.0123456789"
  615.             exit
  616.          case cChar = "-"
  617.              if lGotminus
  618.                exit
  619.             endif
  620.            case cChar = "."
  621.              if lGotdot
  622.                exit
  623.              else
  624.                 lGotdot = .T.
  625.              endif
  626.        endcase
  627.       cNew = substr( cNew, 2 )
  628.        lGotminus = .T.
  629.     enddo
  630.     
  631. RETURN cNew
  632. *-- EoF: StripVal()
  633.  
  634. FUNCTION StrPBrk
  635. *-------------------------------------------------------------------------------
  636. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  637. *-- Date........: 03/01/92
  638. *-- Notes.......: Search string for first occurrence of any of the
  639. *--               characters in charset.  Returns its position as
  640. *--               with at().  Contrary to ANSI.C definition, returns
  641. *--               0 if none of characters is found.
  642. *-- Written for.: dBASE IV
  643. *-- Rev. History: None
  644. *-- Calls.......: None
  645. *-- Called by...: Any
  646. *-- Usage.......: StrPBrk("<cCharSet>","<cBigStr>")
  647. *-- Example.....: ? StrPBrk("Tt","This is a Test string, with Test data")
  648. *-- Returns.....: Numeric value
  649. *-- Parameters..: cCharSet = characters to look for in cBigStr
  650. *--               cBigStr  = string to look in
  651. *-------------------------------------------------------------------------------
  652.  
  653.     parameters cCharset, cBigstring
  654.     private nPos, nLooklen
  655.     nPos = 0
  656.     nLooklen = len( cBigstring )
  657.     do while nPos < nLooklen
  658.       nPos = nPos + 1
  659.         if at( substr( cBigstring, nPos, 1 ), cCharset ) > 0
  660.          exit
  661.        endif
  662.     enddo
  663.     
  664. RETURN iif(nPos=nLookLen,0,nPos)
  665. *-- EoF: StrPBrk()
  666.  
  667. FUNCTION Hav
  668. *-------------------------------------------------------------------------------
  669. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  670. *-- Date........: 03/01/1992
  671. *-- Notes.......: Haversine of an angle in radians
  672. *-- Written for.: dBASE IV, 1.1
  673. *-- Rev. History: None
  674. *-- Calls.......: None
  675. *-- Called by...: Any
  676. *-- Usage.......: Hav(<nX>)
  677. *-- Example.....: ?Hav(48)
  678. *-- Returns.....: Numeric
  679. *-- Parameters..: nX = Return Hav of X
  680. *-------------------------------------------------------------------------------
  681.  
  682.     parameters nX
  683.     
  684. RETURN ( 1 - cos( nX ) ) / 2
  685. *-- EoF: Hav()
  686.  
  687. FUNCTION AHav
  688. *-------------------------------------------------------------------------------
  689. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  690. *-- Date........: 03/01/1992
  691. *-- Notes.......: Inverse haversine - angle size in radians for given
  692. *--               haversine
  693. *-- Written for.: dBASE IV, 1.1
  694. *-- Rev. History: None
  695. *-- Calls.......: None
  696. *-- Called by...: Any
  697. *-- Usage.......: AHav(<nX>)
  698. *-- Example.....: ?AHav(48)
  699. *-- Returns.....: Numeric
  700. *-- Parameters..: nX = Return AHav of X
  701. *-------------------------------------------------------------------------------
  702.  
  703.     parameters nX
  704.     
  705. RETURN acos( 1 - 2 * nX )
  706. *-- EoF: AHav()
  707.  
  708. FUNCTION SinH
  709. *-------------------------------------------------------------------------------
  710. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  711. *-- Date........: 03/01/1992
  712. *-- Notes.......: Hyperbolic sine of an angle X in radians
  713. *-- Written for.: dBASE IV, 1.1
  714. *-- Rev. History: None
  715. *-- Calls.......: None
  716. *-- Called by...: Any
  717. *-- Usage.......: SinH(<nX>)
  718. *-- Example.....: ?SinH(48)
  719. *-- Returns.....: Numeric
  720. *-- Parameters..: nX = Return SinH of X
  721. *-------------------------------------------------------------------------------
  722.  
  723.     parameters nX
  724.     
  725. RETURN ( exp( nX ) - exp( -nX ) ) / 2
  726. *-- EoF: SinH()
  727.  
  728. FUNCTION CScH
  729. *-------------------------------------------------------------------------------
  730. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  731. *-- Date........: 03/01/1992
  732. *-- Notes.......: Hyperbolic cosecant of an angle X in radians
  733. *-- Written for.: dBASE IV, 1.1
  734. *-- Rev. History: None
  735. *-- Calls.......: SINH()               Function in TRIG.PRG
  736. *-- Called by...: Any
  737. *-- Usage.......: CScH(<nX>)
  738. *-- Example.....: ?CScH(48)
  739. *-- Returns.....: Numeric
  740. *-- Parameters..: nX = Return CScH of X
  741. *-------------------------------------------------------------------------------
  742.  
  743.     parameters nX
  744.     
  745. RETURN 1 / sinh( nX )
  746. *-- EoF: CScH()
  747.  
  748. *-------------------------------------------------------------------------------
  749. *-- EoP: NAVIGATE.PRG
  750. *-------------------------------------------------------------------------------
  751.